Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/ng_clone.zip/NG_CLONE.PAS

Pascal/Delphi Source File | 1990-02-21 | 50KB | 1,510 lines

{$M 4096,0,0}                 {Reduce stack and heap}
{$R-,I-}                      {Cut off range and I/O checking}

program ng_clone;
{After all, that's what it is; Thank you, Mr. Norton, you are among my heroes!}

uses    crt,tesstp5;
{TESS version MUST match compiler version}

type

  gentry=record         {General entry type}
    filptr:longint;
    name:string[40];
  end;

  textel= record        {Text-mode screen element}
    cha:byte;
    att:byte;
  end;

  fiftylinebuf= array[1..50,1..80] of textel;   {Video buffer types}
  twelwebuf=    array[1..12,1..80] of textel;
  savedline=    array[1..80] of textel;

var
  screen:fiftylinebuf absolute $B800:$0000;     {Text-mode screen,     }
                                                {should be B000:0000h  }
                                                {on monochrome         }
  csr:word absolute $0040:$0060;                {Low-memory cursor info}
  screenmode:word absolute $0040:$0049;         {Low-memory screen info}
  numrows:word absolute $0040:$0084;            {Low-memory screen info}
  savedscreen:fiftylinebuf;                     {Buffer save current screen on entry}
  smallscreen:twelwebuf;                        {Buffer holds screen template}
  menuline:array[0..1] of savedline;            {Buffer screen template}
  largescreen:array[0..1] of savedline;         {Buffer screen template}
  scrollbuffer:array[0..511] of string[84];     {Buffer guide text entry}
  infobuffer:array[0..511] of longint;          {Buffer guide file info}
  seealso:array[0..19] of gentry;               {Buffer guide file info}
  menu:array[0..2] of string[9]; {Buffer to hold static part of guide menu structure}
  mennu:array[0..3,0..8] of gentry;  {Buffer to hold variable part of guide menu structure}
  backstack:array[0..3] of byte;                {TESS background stack}
  itemlist:array[0..3] of byte;                 {Menu structure info}
  menuplaces,menulengths:array[0..6] of byte;   {Stacks for nested menu structures}
  errorinfo:array[3..6] of string[14];          {Buffer for error messages}
  f:file;                                                                                    {The guide file}
  propath,homedir,streng:string;                {String variables, mostly for path and file use}
  tsrstring:string[8];                          {TESS ID string}
  parent:array[0..3] of longint;                {Stack for nested menu structures}
  poffset:array[0..3] of word;                  {Stack for nested menu structures}
  pcurpos:array[0..3] of byte;                  {Stack for nested menu structures}
  defptr,stackptr:pointer;                      {TESS pointers}
  previous,next:longint;                        {Previous and next entry}
  idnum,i,j,offset,ch,id,bufferlength,savedcsr:word;        {Word variables}
  erro,wix,wiy,curpos,entrytype,seealsonum,sapos,level,scrtypeflag,startline,
  txtattri,
Normal_Text,
UnderScore,
Bold_Face,
Select_Cursor,
Menu_Text,
mlevel,xchoice,ychoice,menux,menuy,menuantal,menunr:byte;        {Byte variables}

procedure hidecrsr; {Make cursor invisible on CGA,EGA or VGA}
begin
  inline($B4/$01/$B5/$20/$CD/$10);
end;

function restorecrsr(crsr:word):boolean;
  {Restore saved cursor on CGA,EGA or VGA}
  inline($B4/$01/$59/$CD/$10);

  function key:word;                                                                    {Keyboard interrupt}
    inline($CD/$16);

    procedure keyread(var karakter:word);
    {Readkey replacement}
      var tch:char;
    begin
      karakter:=key;
      if (lo(karakter)=0) then {If extended key, add 256 to value of key code}
        begin
          tch:=char(hi(karakter));
          karakter:=ord(tch)+256;
        end
      else {Else return key code as is}
        begin
          tch:=char(lo(karakter));
          karakter:=ord(tch);
        end;
    end;

    procedure writestring(cux,cuy,startattr,change,extra:byte;cus:string);        {Direct screen write}
      var jcount,ycount,tmpchr:byte;
        jch:char;
    begin
      jcount:=0;ycount:=0;txtattri:=startattr;
      repeat
        inc(jcount);
        jch:=cus[jcount];
        if jch<>'^' then       {If not NG control code, write character as is}
          begin
            if jch=#255 then   {Expand spaces}
              begin
                inc(jcount);
                jch:=cus[jcount];
                for ycount:=ycount to ycount+ord(jch) do
                  begin
                    screen[cuy,cux+ycount].cha:=32;
                    screen[cuy,cux+ycount].att:=txtattri;
                  end;
              end
            else
              begin
                screen[cuy,cux+ycount].cha:=ord(jch);
                screen[cuy,cux+ycount].att:=txtattri;
                inc(ycount);
              end;
          end
        else                                                                            {Control code found!}
          begin
            inc(jcount);
            jch:=cus[jcount];
            if ((jch='A') or (jch='a')) then    {Color attribute command}
              begin
                inc(jcount);
                jch:=cus[jcount];
                if change=1 then
                  begin
                    if ((ord(jch)>47) and (ord(jch)<58)) then txtattri:=ord(jch)-48 else
                      if ((ord(jch)>64) and (ord(jch)<71)) then txtattri:=ord(jch)-55;
                    txtattri:=16*txtattri;
                  end;
                inc(jcount);
                jch:=cus[jcount];
                if change=1 then
                  begin
                    if ((ord(jch)>47) and (ord(jch)<58)) then txtattri:=txtattri+ord(jch)-48 else
                      if ((ord(jch)>64) and (ord(jch)<71)) then txtattri:=txtattri+ord(jch)-55;
                  end;
              end
            else if ((jch='C') or (jch='c')) then        {Difficult character}
              begin
                inc(jcount);
                jch:=cus[jcount];
                if ((ord(jch)>47) and (ord(jch)<58)) then tmpchr:=ord(jch)-48 else
                  if ((ord(jch)>64) and (ord(jch)<71)) then tmpchr:=ord(jch)-55;
                tmpchr:=16*tmpchr;
                inc(jcount);
                jch:=cus[jcount];
                if ((ord(jch)>47) and (ord(jch)<58)) then tmpchr:=tmpchr+ord(jch)-48 else
                  if ((ord(jch)>64) and (ord(jch)<71)) then tmpchr:=tmpchr+ord(jch)-55;
                screen[cuy,cux+ycount].cha:=tmpchr;
                screen[cuy,cux+ycount].att:=txtattri;
                inc(ycount);
              end
            else if ((jch='b') or (jch='B')) then        {Boldface (?)}
              begin
                if change=1 then
                  begin
                    if txtattri=Normal_Text then txtattri:=Bold_Face else txtattri:=Normal_Text;
                  end;
              end
            else if ((jch='u') or (jch='U')) then        {Underline (?)}
              begin
                if change=1 then
                  begin
                    if txtattri=Normal_Text then txtattri:=UnderScore else txtattri:=Normal_Text;
                  end;
              end
            else if jch='^' then              {Write control character itself}
              begin
                screen[cuy,cux+ycount].cha:=ord(jch);
                screen[cuy,cux+ycount].att:=txtattri;
                inc(ycount);
              end;
          end;
      until jcount>=length(cus);
      if extra>0 then                           {If desired, fill with blanks}
        begin
          while ycount<extra do
            begin
              screen[cuy,cux+ycount].cha:=32;
              screen[cuy,cux+ycount].att:=txtattri;
              inc(ycount);
            end;
        end;
    end;

    procedure threenitvars;                      {Initialize variables}
    begin
      menunr:=0;
      level:=0;
      curpos:=0;
      offset:=0;
      menux:=3;
      menuy:=0;
      mlevel:=0;
      xchoice:=0;
      ychoice:=0;
      sapos:=0;
      wix:=0;wiy:=0;
      txtattri:=Normal_Text;
    end;

    procedure twonitvars;                        {Initialize variables}
    begin
      threenitvars;
      menuplaces[0]:=5;
      menuplaces[1]:=15;
      menuplaces[2]:=28;
      menuplaces[3]:=39;
      menuplaces[4]:=0;
      menuplaces[5]:=0;
      menuplaces[6]:=0;
      menulengths[0]:=20;
      menulengths[1]:=20;
      menulengths[2]:=20;
      menulengths[3]:=0;
      menulengths[4]:=0;
      menulengths[5]:=0;
      menulengths[6]:=0;
      for j:=2 to 79 do smallscreen[1,j].cha:=205;
      for j:=2 to 79 do smallscreen[2,j].cha:=0;
    end;

    procedure initvars;
    {Initialize variables}

      var str5:string;

    begin
      Normal_Text:= 27;         {Color attribute for normal text}
      UnderScore:= 126;         {Color attribute for underline}
      Bold_Face:= 30;           {Color attribute for boldface}
      Select_Cursor:= 48;       {Cursor color attribute}
      Menu_Text := 30;          {Color attribute for Menu Text }
      startline:=0;
      scrtypeflag:=0;
      twonitvars;
      errorinfo[3]:='File not found';
      errorinfo[4]:='Not an NG file';
      errorinfo[5]:='Unexpected EOF';
      errorinfo[6]:='Corrupted file';
      menu[0]:='Expand';
      menu[1]:='Search...';
      menu[2]:='Options';
      str5:='';propath:=paramstr(0);
      while (pos('\',propath)>0) do
        begin
          str5:=str5+copy(propath,1,pos('\',propath));
          propath:=copy(propath,pos('\',propath)+1,length(propath)-(pos('\',propath)+1));
        end;
      propath:=str5;
    end;

    procedure initscreen;
    {Read screen template from disk}
      var sf:file;
        numread:word;
    begin
      assign(sf,propath+'ng_clone.scr');
      reset(sf,1);
      blockread(sf,smallscreen,sizeof(smallscreen),numread);
      blockread(sf,menuline[1],sizeof(menuline[1]),numread);
      for i:=1 to 80 do largescreen[0,i]:=smallscreen[5,i];
      for i:=1 to 80 do largescreen[1,i]:=smallscreen[11,i];
      close(sf);
    end;

    procedure removecursor;
    {Next follows different cursor procedures}
      var sl:byte;
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      writestring(2,4+curpos+sl,Normal_Text,1,78,scrollbuffer[curpos+offset]);
    end;

    procedure insertcursor;
    {Another cursor procedure}
      var sl:byte;
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      writestring(2,4+curpos+sl,Select_Cursor,0,78,scrollbuffer[curpos+offset]);
    end;

    procedure removemenucursor;
    {Another cursor procedure}
      var sl:byte;
        cursor:string[78];
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      if menux>2 then cursor:=' '+mennu[menux-3,0].name+' ' else
        cursor:=' '+menu[menux]+' ';
      writestring(menuplaces[menux]-1,2+sl,txtattri,0,0,cursor);
    end;

    procedure insertmenucursor;
    {Another cursor procedure}
    begin
      txtattri:=Select_Cursor;
      removemenucursor;
      txtattri:=Normal_Text;
    end;

    procedure movemenucursor(direction:byte);
    {Another cursor procedure}
      var sl:byte;
    begin
      if ((entrytype=1) or (level=0)) then
        begin
          if scrtypeflag=0 then sl:=startline else sl:=0;
          txtattri:=Bold_Face;
          removemenucursor;
          if direction=0 then
            begin
              if menux>0 then dec(menux) else menux:=2+menuantal;
            end
          else
            begin
              if menux<2+menuantal then inc(menux) else menux:=0;
            end;
          insertmenucursor;
          for j:=1 to 80 do menuline[0][j]:=screen[2+sl,j];
        end;
    end;

    procedure removemlcursor;
    {Another cursor procedure}
      var    cursor:string[78];
    begin
      if ((menux-3=xchoice) and (menuy=ychoice)) then cursor:=#251+' '+mennu[menux-3,menuy+1].name else
        cursor:='  '+mennu[menux-3,menuy+1].name;
      while length(cursor)<menulengths[menux]+3 do cursor:=cursor+' ';
      writestring(2+wix,2+menuy+wiy,txtattri,0,0,cursor);
    end;

    procedure insertmlcursor;
    {Another cursor procedure}
    begin
      txtattri:=Select_Cursor;
      removemlcursor;
      txtattri:=Normal_Text;
    end;

    procedure removeseealso;
    {Another cursor procedure}
      var addo,sl:byte;
        cursor:string[78];
    begin
      addo:=0;
      if scrtypeflag=0 then sl:=startline else sl:=0;
      for j:=0 to sapos do
        begin
          if j>0 then inc(addo,length(seealso[j-1].name)+2);
        end;
      cursor:=' '+seealso[sapos].name+' ';
      writestring(13+addo,2+sl,txtattri,0,0,cursor);
    end;

    procedure insertseealso;
    {Another cursor procedure}
    begin
      txtattri:=Select_Cursor;
      removeseealso;
      txtattri:=Normal_Text;
    end;

    procedure moveseealso(direction:byte);
    {Another cursor procedure}
    begin
      if seealsonum<>255 then
        begin
          removeseealso;
          if direction=0 then
            begin
              if sapos>0 then dec(sapos) else sapos:=seealsonum;
            end
          else
            begin
              if sapos<seealsonum then inc(sapos) else sapos:=0;
            end;
          insertseealso;
        end;
    end;

    procedure frame1(w,d:byte);
   {Frame of line-drawing charcters used for menu}
    begin
      writestring(wix+1,wiy+1,Normal_Text,0,0,'┬');
      for i:=2 to d-1 do
        begin
          writestring(1+wix,i+wiy,Normal_Text,0,0,'│');
          writestring(w+wix,i+wiy,Normal_Text,0,0,'│');
        end;
      writestring(wix+1,wiy+d,Normal_Text,0,0,'└');
      for i:=2 to w-1 do writestring(wix+i,wiy+d,Normal_Text,0,0,'─ ');
      writestring(wix+i+1,wiy+1,Normal_Text,0,0,'┬');
      writestring(wix+i+1,wiy+d,Normal_Text,0,0,'┘');
    end;

    procedure createsmall;
    {Save current screen and create small screen}
    begin
      savedscreen:=screen;
      hidecrsr;
      for i:=1 to 12 do
        for j:=1 to 80 do
          screen[i+startline,j]:=smallscreen[i,j];
      writestring(5,2+startline,Bold_Face,0,0,menu[0]);
      writestring(15,2+startline,Bold_Face,0,0,menu[1]);
      writestring(28,2+startline,Bold_Face,0,0,menu[2]);
      writestring(39,2+startline,Bold_Face,0,0,mennu[0,0].name);
      if menuantal>1 then
        begin
          i:=length(mennu[0,0].name);
          menuplaces[4]:=43+i;
          writestring(43+i,2+startline,Bold_Face,0,0,mennu[1,0].name);
        end;
      if menuantal>2 then
        begin
          inc(i,length(mennu[1,0].name));
          menuplaces[5]:=47+i;
          writestring(47+i,2+startline,Bold_Face,0,0,mennu[2,0].name);
        end;
      if menuantal>3 then
        begin
          inc(i,length(mennu[2,0].name));
          menuplaces[6]:=51+i;
          writestring(51+i,2+startline,Bold_Face,0,0,mennu[3,0].name);
        end;
      i:=0;
      while ((i<bufferlength+1) and (i<8)) do
        begin
          writestring(2,4+i+startline,Normal_Text,1,78,scrollbuffer[i]);inc(i);
        end;
      for i:=1 to 12 do
        for j:=1 to 80 do
          smallscreen[i,j]:=screen[i+startline,j];
      insertmenucursor;
      screen[5+startline,80].att:=$40;
      for j:=1 to 80 do menuline[0][j]:=screen[2+startline,j];
    end;

    procedure blank(width,height:byte);       {Blank part of screen}
    begin
      for i:=2 to height do for j:=1 to width do
          begin
            screen[wiy+i,wix+j].att:=Normal_Text;
            screen[wiy+i,wix+j].cha:=0;
          end;
    end;

    procedure makemenu(num:byte);             {Make pull-down menu}
      var windstart,sl:byte;
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      if (menulengths[num]+menuplaces[num]+5>79) then
        windstart:=79-(menulengths[num]+5)
      else
        windstart:=menuplaces[num]-2;
      wix:=windstart-1;wiy:=2+sl;
      blank(menulengths[num]+4,itemlist[num-3]+1);
      frame1(menulengths[num]+5,1+itemlist[num-3]);
      for i:=1 to itemlist[num-3]-1 do
        begin
          writestring(4+wix,1+i+wiy,Normal_Text,0,0,mennu[num-3,i].name);
        end;
      if num-3=xchoice then
        begin
          writestring(2+wix,2+ychoice+wiy,Normal_Text,0,0,#251);
        end;
      insertmlcursor;
      mlevel:=1;
    end;

    procedure writeseealsos(possible_offset:byte);
    {Write seealso entries}
      var satmp:word;
    begin
      if seealsonum<>255 then
        begin
          j:=0;satmp:=0;
          for i:=0 to seealsonum do
            begin
              writestring(14+j,2+possible_offset,Normal_Text,0,0,seealso[i].name);
              inc(j,length(seealso[i].name)+2);
              if i<seealsonum then
                begin
                  if (15+j+length(seealso[i+1].name)>79) then
                    begin
                      satmp:=i;
                      i:=seealsonum;
                    end
                  else satmp:=0;
                end;
            end;
          if satmp>0 then seealsonum:=satmp;
          insertseealso;
        end;
    end;

    procedure makesmall(vertical_offset:byte);
    {Repaint small screen}
    begin
      if ((entrytype=1) or (level=0)) then
        begin
          for i:=1 to vertical_offset do
            for j:=1 to 80 do screen[i,j]:=savedscreen[i,j];
          for j:=1 to 80 do screen[vertical_offset+1,j]:=smallscreen[1,j];
          for j:=1 to 80 do screen[vertical_offset+2,j]:=menuline[0][j];
          for i:=3 to 12 do
            for j:=1 to 80 do screen[i+vertical_offset,j]:=smallscreen[i,j];
          for i:=(13+vertical_offset) to lo(numrows)+1 do
            for j:=1 to 80 do screen[i,j]:=savedscreen[i,j];
        end
      else
        begin
          for i:=1 to vertical_offset do
            for j:=1 to 80 do
              screen[i,j]:=savedscreen[i,j];
          for j:=1 to 80 do
            screen[vertical_offset+1,j]:=smallscreen[1,j];
          for j:=1 to 80 do
            screen[vertical_offset+2,j]:=menuline[1][j];
          for i:=3 to 12 do
            for j:=1 to 80 do
              screen[i+vertical_offset,j]:=smallscreen[i,j];
          for i:=(13+vertical_offset) to lo(numrows)+1 do
            for j:=1 to 80
              do screen[i,j]:=savedscreen[i,j];
          writeseealsos(vertical_offset);
        end;
      if entrytype=1 then
        begin
          if curpos>7 then
            begin
              inc(offset,curpos-7);
              curpos:=7;
            end;
        end;
      if entrytype=1 then insertcursor;
      for i:=5 to 10 do
        screen[i+vertical_offset,80].att:=$07;
      i:=(((curpos+offset)*6) div (bufferlength+1))+5;
      if i>10 then i:=10;
      screen[i+vertical_offset,80].att:=$40;
    end;

    procedure makelarge;
    {Repaint large screen}
      var    add:byte;
    begin
      if ((entrytype=1) or (level=0)) then
        begin
          for j:=1 to 80 do
            screen[1,j]:=smallscreen[1,j];
          for j:=1 to 80
            do screen[2,j]:=menuline[0][j];
          for i:=3 to 10
            do for j:=1 to 80 do screen[i,j]:=smallscreen[i,j];
          for i:=11 to lo(numrows)-1 do
            for j:=1 to 80 do
              screen[i,j]:=largescreen[0,j];
          for j:=1 to 80 do
            screen[lo(numrows),j]:=largescreen[1,j];
          for j:=1 to 80 do
            screen[lo(numrows)+1,j]:=smallscreen[12,j];
        end
      else
        begin
          for j:=1 to 80 do
            screen[1,j]:=smallscreen[1,j];
          for j:=1 to 80 do
            screen[2,j]:=menuline[1][j];
          for i:=3 to 10 do
            for j:=1 to 80
              do screen[i,j]:=smallscreen[i,j];
          for i:=11 to lo(numrows)-1 do
            for j:=1 to 80 do
              screen[i,j]:=largescreen[0,j];
          for j:=1 to 80 do
            screen[lo(numrows),j]:=largescreen[1,j];
          for j:=1 to 80 do
            screen[lo(numrows)+1,j]:=smallscreen[12,j];
          writeseealsos(0);
        end;
      if offset+lo(numrows)-4>bufferlength then
        begin
          if bufferlength>offset+lo(numrows)-4 then
            begin
              add:=offset-bufferlength+lo(numrows)-4;
              inc(curpos,add);
              offset:=bufferlength-lo(numrows)+4;
            end
          else
            begin
              inc(curpos,offset);
              offset:=0;
            end;
        end;
      i:=0;
      while ((i+offset<bufferlength+1) and (i<lo(numrows)-3)) do
        begin
          writestring(2,4+i,Normal_Text,1,78,scrollbuffer[i+offset]);inc(i);
        end;
      if i<lo(numrows)-3 then for i:=i to lo(numrows)-4 do
          begin
            writestring(2,4+i,Normal_Text,0,78,' ');
          end;
      if entrytype=1 then
        begin
          if curpos>7 then add:=curpos-7 else add:=0;
        end
      else
        begin
          add:=0;
        end;
      for i:=4 to 11 do for j:=2 to 79 do smallscreen[i,j]:=screen[i+add,j];
      if entrytype=1 then insertcursor;
      for i:=5 to lo(numrows)-1 do screen[i,80].att:= 27;
      i:=(((curpos+offset)*(lo(numrows)-5)) div (bufferlength+1))+5;
      if i>lo(numrows)-1 then i:=lo(numrows)-1;
      screen[i,80].att:=$40;
      if mlevel=1 then makemenu(menux);
    end;

    procedure usage;
    {Write usage info}
    begin
      writeln('NG_CLONE USAGE   :');
      writeln('──────────────────');
      writeln;
      writeln('  ng_clone <'+#123+'d:\dir\'+#125+'file'+#123+'.ext'+#125+'> '+#123+
      '<d:\ngdir>'+#125+' <+/->  :run NG_CLONE (see below)');
      writeln('  ng_clone </u> or </U>                           :remove NG_CLONE if resident');
      writeln('  ng_clone </?> or </h> or </H>                   :show this usage information');
      writeln;
      writeln('  The +/- entry is NOT optional, but  used by NG_CLONE to determine whether or');
      writeln('  not to install itself as a resident program.');
    end;

    procedure slutlort(b:byte);
    {Exit on error and display relevant error message}
    begin
      if b>3 then close(f);
      if b>2 then
        begin
          write('NG_CLONE ERROR #');write(b);writeln(': '+errorinfo[b]+', cannot proceed');
        end;
      if b<3 then usage;
      halt(0);
    end;

    procedure sllut(b:byte);
    {Error handler without exit, just indicating the error type}
      var sl:byte;
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      if b>3 then close(f);
      writestring(4,4+sl,Normal_Text,0,74,' '+errorinfo[b]+' - Press any key');
      erro:=1;
    end;

    function decrypt(b:byte):byte;
    {Decrypt byte from NG format}
    begin
      if ((b and 31)>=16) then b:=b-16 else b:=b+16;
      if ((b and 15)>=8) then b:=b-8 else b:=b+8;
      if ((b and 3)>=2) then b:=b-2 else b:=b+2;
      decrypt:=b;
    end;

    function read_byte:byte;
    {Read and decrypt byte}
      var
        tb:byte;
        numread:word;
    begin
      blockread(f,tb,1,numread);
      read_byte:=decrypt(tb);
    end;

    function read_word:word;
    {Read and decrypt word}
      var
        tw:word;

    begin
      tw:=read_byte;
      read_word:=tw + (word(read_byte) shl 8);
    end;

    function read_long:longint;
    {Read and decrypt longint}
      var tl:longint;

    begin
      tl:=read_word;
      read_long:=tl + (longint(read_word) shl 16);
    end;

    procedure read_menu;
    {Read a menu structure into the menu buffer}
      var items:word;
    begin
      mennu[menunr,0].filptr:=filepos(f)-2;
      seek(f,filepos(f)+2);
      items:=read_word;
      itemlist[menunr]:=items;
      seek(f,filepos(f)+20);
      for i:=1 to items-1 do
        begin
          mennu[menunr,i].filptr:=read_long;
        end;
      i:=filepos(f);
      inc(i,(items*8));
      seek(f,i);
      for i:=0 to items-1 do
        begin
          j:=0;
          repeat
            mennu[menunr,i].name[j+1]:=chr(read_byte);
            inc(j);
          until (mennu[menunr,i].name[j]=#0);
          mennu[menunr,i].name[0]:=chr(j-1);
          if j-1>menulengths[menunr+3] then menulengths[menunr+3]:=j-1;
        end;
      seek(f,filepos(f)+1);
    end;

    procedure skip_short_long;        {Skip procedure for the initial menu seek}
      var length:word;
    begin
      length:=read_word;
      seek(f,filepos(f)+22+length);
    end;

    procedure read_header(modf:byte);
    {Read NG file header and enter the guide name in the screen template}
      var guidenavn:string;
        buf:array[0..377] of byte;
        numread:word;
    begin
      blockread(f,buf,sizeof(buf),numread);
      if ((buf[0]<>78) or (buf[1]<>71)) then
 {If the two first characters in the file are not 'NG', the file is no guide}
        begin
          if modf=0 then slutlort(4) else sllut(4);
        end;
      menuantal:=buf[6];
      i:=0;
      repeat
        guidenavn[i+1]:=chr(buf[i+8]);
        inc(i);
      until (buf[i+8]=0);
      guidenavn[0]:=chr(i);
      guidenavn:=' The Norton Guide to '+guidenavn+' ';
      for i:=1 to length(guidenavn) do
        begin
          smallscreen[1,39-(length(guidenavn) div 2)+i].cha:=ord(guidenavn[i]);
        end;
      seek(f,378);
    end;

    procedure read_menus(modf:byte);
    {Initial menu seek, indexing the whole file}
    begin
      repeat
        id:=read_word;
        if id<2 then skip_short_long
        else
          if id=2 then
            begin
              read_menu;
              inc(menunr);
            end
          else
            if (id<>5) then
              begin
                if (filesize(f)<>filepos(f)) then
                  begin
                    if modf=0 then slutlort(5) else sllut(5);        {NG file error}
                  end
                else id:=5;
              end;
      until (id=5);
      if (menunr<>menuantal) then
        begin
          if modf=0 then slutlort(6) else sllut(6);   {Incomplete file}
        end;
    end;

    procedure read_strings(totnum:word);
    {Read null-terminated strings into scroll buffer}
      var stringchar:byte;
    begin
      for i:=1 to totnum do
        begin
          j:=0;
          repeat
            stringchar:=read_byte;
            inc(j);
            scrollbuffer[i-1][j]:=chr(stringchar);
          until stringchar=0;
          scrollbuffer[i-1][0]:=chr(j-1);
        end;
      bufferlength:=totnum-1;
      for j:=bufferlength+1 to 511 do scrollbuffer[j]:='';
    end;

    procedure read_short_entry;
    {Read short entry from file and wring some information out of it}
      var items:word;
    begin
      seek(f,filepos(f)+2);
      items:=read_word;
      seek(f,filepos(f)+20);
      for i:=1 to items do
        begin
          seek(f,filepos(f)+2);
          infobuffer[i-1]:=read_long;
        end;
      read_strings(items);
      entrytype:=1;
    end;

    procedure read_long_entry;
    {Read long entry information}
      var linens,dlength,seealso_num:word;
        prev,nxt:longint;
        stringchar:byte;
    begin
      seek(f,filepos(f)+2);
      linens:=read_word;
      dlength:=read_word;
      seek(f,filepos(f)+10);
      prev:=read_long;
      nxt:=read_long;
      read_strings(linens);
      if dlength<>0 then                                                        {If there are seealso entries, read them}
        begin
          seealso_num:=read_word;
          for i:=1 to seealso_num do
            begin
              if i<21 then seealso[i-1].filptr:=read_long else seek(f,filepos(f)+4);
            end;
          for i:=1 to seealso_num do
            begin
              if i<21 then
                begin
                  j:=0;
                  repeat
                    stringchar:=read_byte;
                    inc(j);
                    seealso[i-1].name[j]:=chr(stringchar);
                  until stringchar=0;
                  seealso[i-1].name[0]:=chr(j-1);
                end;
            end;
          seealsonum:=seealso_num-1;
          if seealsonum>19 then seealsonum:=19;
        end
      else seealsonum:=255;
      entrytype:=2;
      previous:=prev;
      next:=nxt;
    end;

    procedure read_entry(fp:longint);
    {Read some kind of file entry}
    begin
      seek(f,fp);
      id:=read_word;
      case id of
      0:    read_short_entry;
      1:    read_long_entry;
      end;
      if ((id=0) or (level=0)) then parent[level]:=fp;
    end;

    procedure scrollinsert(addo_ins,directf:byte);
    {Insert for the scroll procedure}
      var sl:byte;
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      if directf=0 then dec(offset) else inc(offset);
      for i:=0 to addo_ins-1 do
        begin
          writestring(2,4+i+sl,Normal_Text,1,78,scrollbuffer[i+offset]);
        end;
    end;

    procedure scroll(direction:byte);
    {Scroll text screen}
      var addo,sl:byte;
    begin
      addo:=(scrtypeflag*13)+8;
      if scrtypeflag=0 then sl:=startline else sl:=0;
      if scrtypeflag=1 then inc(addo,lo(numrows)-24);
      if entrytype=1 then
        begin
          removecursor;
          if direction=0 then
            begin
              if curpos>0 then
                begin
                  dec(curpos);
                end
              else
                begin
                  if offset>0 then scrollinsert(addo,0);
                end;
            end
          else
            begin
              if curpos<addo-1 then
                begin
                  if curpos<bufferlength then
                    begin
                      inc(curpos);
                    end;
                end
              else
                begin
                  if offset+addo<bufferlength+1 then scrollinsert(addo,1);
                end;
            end;
          insertcursor;
        end
      else
        begin
          if direction=0 then
            begin
              if offset>0 then scrollinsert(addo,0);
            end
          else
            begin
              if offset+addo<bufferlength+1 then scrollinsert(addo,1);
            end;
        end;
      if curpos>7 then addo:=curpos-7 else addo:=0;
      if scrtypeflag=0 then
        for i:=4 to 11 do
          for j:=2 to 79 do smallscreen[i,j]:=screen[i+startline,j]
      else
        for i:=4 to 11 do
          for j:=2 to 79 do smallscreen[i,j]:=screen[i+addo,j];
      if scrtypeflag=0
        then j:=10
      else
        j:=lo(numrows)-1;
      for i:=5 to j
        do screen[i+sl,80].att:=$07;
      i:=(((curpos+offset)*(j-4)) div (bufferlength+1))+5;
      if i>j then i:=j;
      screen[i+sl,80].att:=$40;
    end;

    procedure keycommons;
    {General screen repaint}
    begin
      if scrtypeflag=0 then
        begin
          makesmall(startline);
          if entrytype=1 then removecursor;
          i:=0;
          while ((i<bufferlength+1) and (i<8)) do
            begin
              writestring(2,4+i+startline,Normal_Text,1,78,scrollbuffer[i+offset]);inc(i);
            end;
          if i<8 then for i:=i to 7 do
              begin
                writestring(2,4+i+startline,Normal_Text,0,78,' ');
              end;
          for i:=4 to 11 do for j:=2 to 79 do smallscreen[i,j]:=screen[i+startline,j];
          if entrytype=1 then insertcursor;
        end
      else
        begin
          makelarge;
        end;
    end;

    procedure pgup;
    {Page up procedure for the text screen}
      var addo:byte;
    begin
      addo:=(scrtypeflag*13)+8;
      if scrtypeflag=1 then inc(addo,lo(numrows)-24);
      if entrytype=1 then
        begin
          if curpos>0 then
            begin
              removecursor;
              curpos:=1;
            end
          else
            begin
              dec(offset,addo-2);
              if ((offset<1) or (offset>10000)) then offset:=1;
            end;
        end
      else
        begin
          curpos:=0;
          dec(offset,addo-2);
          if ((offset<1) or (offset>10000)) then offset:=1;
        end;
      scroll(0);
    end;

    procedure pgdn;
    {Page down procedure for the text screen}
      var addo:byte;
    begin
      addo:=(scrtypeflag*13)+8;
      if scrtypeflag=1 then inc(addo,lo(numrows)-24);
      if entrytype=1 then
        begin
          if curpos<addo-1 then
            begin
              removecursor;
              curpos:=addo-2;
              if curpos>bufferlength-1 then curpos:=bufferlength-1;
            end
          else
            begin
              inc(offset,addo-2);
              if offset+addo>bufferlength then offset:=bufferlength-addo;
            end;
        end
      else
        begin
          curpos:=addo-1;
          inc(offset,addo-2);
          if offset+addo>bufferlength then offset:=bufferlength-addo;
          if offset>10000 then offset:=0;
        end;
      scroll(1);
    end;

    procedure getstreng;
    {Read string from keyboard and echo it on screen}
      var chii:word;
        stl,sl:byte;
        chin:char;
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      streng:='';stl:=0;
      writestring(15,4+sl,Normal_Text+128,0,0,#219);
      repeat
        keyread(chii);chin:=chr(lo(chii));
        if ((31<chii) and (chii<256) and (length(streng)<62)) then
          begin
            writestring(15+stl,4+sl,Normal_Text,0,0,upcase(chin));
            streng:=streng+upcase(chin);
            inc(stl);
            writestring(15+stl,4+sl,Normal_Text+128,0,0,#219);
          end;
        if ((chii=8) and (length(streng)>0)) then
          begin
            writestring(15+stl,4+sl,Normal_Text,0,0,#0);
            streng:=copy(streng,1,length(streng)-1);
            dec(stl);
            writestring(15+stl,4+sl,Normal_Text+128,0,0,#219);
          end;
      until ((chii=13) or (chii=27));
      if chii=27 then streng:='';
    end;

    procedure s_o_l_insert;
    {Insert for the search-or-load procedure}
      var savl:byte;
    begin
      screen:=savedscreen;
      if scrtypeflag=1 then
        begin
          savl:=startline;
          startline:=0;
          createsmall;
          makelarge;
          startline:=savl;
        end
      else createsmall;
      insertcursor;
      makemenu(3);
    end;

    procedure exitmenus;
    {Remove pull-down menu}
      var add:byte;
    begin
      mlevel:=0;menuy:=0;wix:=0;wiy:=0;
      if scrtypeflag=0 then makesmall(startline) else
        begin
          for j:=1 to 80 do screen[3,j]:=smallscreen[3,j];
          i:=0;
          while ((i+offset<bufferlength+1) and (i<9)) do
            begin
              writestring(2,4+i,Normal_Text,1,78,scrollbuffer[i+offset]);inc(i);
            end;
          if entrytype=1 then insertcursor;
          for i:=5 to lo(numrows)-1 do screen[i,80].att:=$07;
          i:=(((curpos+offset)*(lo(numrows)-5)) div (bufferlength+1))+5;
          if i>lo(numrows)-1 then i:=lo(numrows)-1;
          screen[i,80].att:=$40;
        end;
    end;

    procedure search_or_load(typ:byte;namest:string);
    {Search for entry or load new NG file}
      var sl,savl:byte;
        tmpchr:word;
        savst:string;
    begin
      if scrtypeflag=0 then sl:=startline else sl:=0;
      wix:=2;wiy:=2+sl;
      frame1(76,3);
      writestring(4,4+sl,Normal_Text,0,74,namest);
      savst:=streng;
      getstreng;
      if streng<>'' then
        begin
          if typ=0 then
            begin
{SEARCH begins - feel free to add this yourself}
              if scrtypeflag=0 then
                begin
                  makesmall(startline);
                end
              else
                begin
                  makelarge;
                end;
              wix:=0;wiy:=0;
{SEARCH ends - feel free to add this yourself}
            end
          else
            begin
            {Load new guide file}
              erro:=0;
              if pos('.',streng)=0 then streng:=streng+'.NG';
              if ((pos('\',streng)=0) and (pos(':',streng)=0)) then
              writestring(4,4+sl,Normal_Text,0,74,' Loading '+homedir+streng+' - please wait') else
                writestring(4,4+sl,Normal_Text,0,74,' Loading '+streng+' - please wait');
              close(f);
              twonitvars;
              if ((pos('\',streng)=0) and (pos(':',streng)=0)) then assign(f,homedir+streng) else assign(f,streng);
              reset(f,1);
              if ioresult<>0 then
                begin
                  sllut(3);
                end;
              if erro=0 then
                begin
                  read_header(1);
                end;
              if erro=0 then
                begin
                  read_menus(1);
                end;
              if erro=0 then
                begin
                  read_entry(mennu[0,1].filptr);
                  s_o_l_insert;
                end
              else
                begin {If there are any errors, we reload the old guide file}
                  keyread(tmpchr);
                  streng:=savst;
                  twonitvars;
                  if ((pos('\',streng)=0) and (pos(':',streng)=0)) then
                  assign(f,homedir+streng) else assign(f,streng);
                  reset(f,1);
                  read_header(1);
                  read_menus(1);
                  read_entry(mennu[0,1].filptr);
                  s_o_l_insert;
                end;
            end;
        end
      else exitmenus;
    end;

    procedure escape_insert;
    {Insert for the ESC key handler}
    begin
      dec(level);
      read_entry(parent[level]);
      if ((level>0) or (entrytype=1)) then
        begin
          curpos:=pcurpos[level];offset:=poffset[level];
        end;
      sapos:=0;
      keycommons;
      ch:=0;
    end;

    procedure keyhandler;
    {Reads key from keyboard and decides which action to take}
      var sl:byte;
        tmpchr,tmo,tmc:word;
    begin
      repeat
        keyread(ch);
        case ch of
        43:        begin {'+' key - moves small screen one line down}
            if scrtypeflag=0 then
              begin
                if startline<lo(numrows)-11 then
                  begin
                    inc(startline);
                    for i:=startline+11 downto startline do
                      for j:=1 to 80 do
                        screen[i+1,j]:=screen[i,j];
                    for j:=1 to 80 do
                      screen[startline,j]:=savedscreen[startline,j];
                    if mlevel=1 then inc(wiy);
                  end;
              end;
          end;
        45:        begin {'-' key - moves small screen one line up}
            if scrtypeflag=0 then
              begin
                if startline>0 then
                  begin
                    dec(startline);
                    for i:=startline to startline+11 do
                      for j:=1 to 80 do
                        screen[i+1,j]:=screen[i+2,j];
                    for j:=1 to 80 do
                      screen[13+startline,j]:=savedscreen[13+startline,j];
                    if mlevel=1 then dec(wiy);
                  end;
              end;
          end;
        328:    if mlevel=0 then scroll(0) else        {UpArrow key}
            begin
              removemlcursor;
              if menuy>0 then dec(menuy) else menuy:=itemlist[menux-3]-2;
              insertmlcursor;
            end;
        336:    if mlevel=0 then scroll(1) else        {DownArrow key}
            begin
              removemlcursor;
              if menuy<itemlist[menux-3]-2 then inc(menuy) else menuy:=0;
              insertmlcursor;
            end;
        329:    if mlevel=0 then pgup;    {PgUp key}
        337:    if mlevel=0 then pgdn;    {PgDn key}
        327:    if entrytype=2 then       {Home key - go to previous entry}
            begin
              if level>0 then
                begin
                  if previous>0 then
                    begin
                      read_entry(previous);
                      curpos:=0;offset:=0;sapos:=0;
                      keycommons;
                    end;
                end;
            end;
        335:    if entrytype=2 then       {End key - go to next entry}
            begin
              if level>0 then
                begin
                  if next>0 then
                    begin
                      read_entry(next);
                      curpos:=0;offset:=0;sapos:=0;
                      keycommons;
                    end;
                end;
            end;
        331:    if mlevel=0 then          {LeftArrow key}
            begin
              if ((entrytype=1) or (level=0)) then
                movemenucursor(0)
              else
                moveseealso(0);
            end
          else
            begin
              exitmenus;
              movemenucursor(0);
            end;
        333:    if mlevel=0 then          {RightArrow key}
            begin
              if ((entrytype=1) or (level=0)) then
                movemenucursor(1)
              else
                moveseealso(1);
            end
          else
            begin
              exitmenus;
              movemenucursor(1);
            end;
        9    :     begin {Tab key - toggles between small and large screens}
            if scrtypeflag=0 then
              begin
                scrtypeflag:=1;
                makelarge;
              end
            else
              begin
                scrtypeflag:=0;
                makesmall(startline);
                if mlevel=1 then makemenu(menux);
              end;
          end;
        13:        if ((entrytype=1) or (level=0)) then
                {ENTER key handler}
            begin
              if menux=0 then
                begin
                  tmc:=curpos;tmo:=offset;
                  pcurpos[level]:=curpos;poffset[level]:=offset;
                  curpos:=0;offset:=0;
                  inc(level);
                  read_entry(infobuffer[tmc+tmo]);
                  keycommons;
                end
              else if menux=1 then
                begin
                  search_or_load(0,' Look for:');
                end
              else if menux=2 then
                begin
                  search_or_load(1,' New file:');
                end
              else
                begin
                  if mlevel=0 then makemenu(menux)
                  else
                    begin
                      read_entry(mennu[menux-3,menuy+1].filptr);
                      if entrytype=2 then inc(level);
                      xchoice:=menux-3;ychoice:=menuy;
                      curpos:=0;offset:=0;mlevel:=0;menuy:=0;
                      keycommons;
                    end;
                end;
            end
          else
            begin
              if seealsonum<>255 then
                begin
                  read_entry(seealso[sapos].filptr);
                  curpos:=0;offset:=0;sapos:=0;
                  keycommons;
                end;
            end;
        27:        if ((entrytype=2) and (level>0)) then        {ESC key handler}
            begin
              escape_insert;
            end
          else if mlevel=1 then
            begin
              exitmenus;
              ch:=0;
            end
          else
            begin
              if level>0 then
                begin
                  escape_insert;
                end
              else
                begin
                  if scrtypeflag=0 then sl:=startline else sl:=0;
                  wix:=2;wiy:=2+sl;
                  frame1(40,3);
                  writestring(4,4+sl,Bold_Face,0,38,' Do you really want to quit (Y/N) ?');
                  repeat
                    keyread(tmpchr);
                  until ((upcase(chr(lo(tmpchr)))='Y') or (upcase(chr(lo(tmpchr)))='N'));
                  writestring(40,4+sl,Bold_Face,0,0,upcase(chr(lo(tmpchr))));
                  i:=0;while i<65535 do inc(i);
                  if upcase(chr(lo(tmpchr)))='N' then
                    begin
                      if scrtypeflag=0 then makesmall(startline) else makelarge;
                      ch:=0;
                    end;
                end;
            end;
        end;
      until ch=27;
    end;

    function sizeofcode:word;          {TESS function to decide size of
                                        resident code}
      var used:word;
    begin
      used:=seg(heapptr^)-prefixseg;
      sizeofcode:=used;
    end;

{$F+} procedure tsrmainproc; {$F-}     {TESS resident procedure entry point}
    begin
      if ((lo(screenmode)<4) or (lo(screenmode)=7)) then
        begin
          savedcsr:=csr;
          threenitvars;
          startline:=0;
          scrtypeflag:=0;
          read_entry(mennu[0,1].filptr);
          createsmall;
          insertcursor;
          makemenu(3);
          keyhandler;
          screen:=savedscreen;
          if restorecrsr(savedcsr) then i:=i;
        end
      else
        begin
          tessbeep;
        end;
    end;

{$F+} procedure tsrcleanup(removetsr:boolean); {$F-}
{TESS install-or-remove procedure entry point}
    begin
      if (removetsr) then
        begin
          close(f);
          erroraddr:=NIL;
        end
      else
        begin
          initscreen;
          read_header(0);
          read_menus(0);
          write('NG_CLONE installed                                            Hotkey: Ctrl-Alt-G');
        end;
    end;

{
++ Main Loop and Command-Line parser
}

  begin
    directvideo:=true;           {Force write and writeln direct to screen}
    writeln('┌────────────────────────────┐');
    writeln('│ Norton Guides Clone V. 1.1 │');
    writeln('│   (c) 1989 J.P.Pedersen    │');
    writeln('└────────────────────────────┘');
    initvars;                                                                        {Initialize global variables}
    tsrstring:='NG_CLONE';        {TESS ID string - rather original, eh?}
    tssetadrtp4(@tsrmainproc,2);  {Set TESS entry point}
    tssetadrtp4(@tsrcleanup,5);   {Set TESS entry point}
    defptr:=NIL;                                                                {TESS stack pointer #1}
    stackptr:=@backstack[(sizeof(backstack)-3)];        {TESS stack pointer #2}
    tssetstack(defptr^,stackptr^);            {Initialize TESS stacks}
    if (tscheckresident(tsrstring[1],idnum)=$FFFF) then        {Is NG_CLONE already resident?}
      begin
        if ((paramstr(1)='/U') or (paramstr(1)='/u')) then  {If uninstall command, then do so}
          begin
            writeln('NG_CLONE removed from memory');
            i:=tsrelease(idnum);
            halt(0);
          end
        else
          begin {Else report presence and exit}
            write('NG_CLONE already installed                                    Hotkey: Ctrl-Alt-G');
            halt(0);
          end;
      end
    else
      begin                                                                                                    {Else}
        if ((paramstr(1)='/U') or (paramstr(1)='/u')) then {If program is not resident, it cannot be removed!}
          begin
            writeln('NG_CLONE has not been installed!');
            halt(0);
          end;
      end;
    if ((paramstr(1)='/?') or (paramstr(1)='/h') or (paramstr(1)='/H')) then slutlort(0);        {Write usage info and exit}
    if paramcount<2 then slutlort(1);         {Command-line syntax error}
    if paramcount>3 then slutlort(2);         {Command-line syntax error}
    streng:=paramstr(1);
    if paramcount=3 then homedir:=paramstr(2)+'\' else homedir:='';        {Check for ngdir entry on command-line}
    if pos('.',streng)=0 then streng:=streng+'.NG';        {Expand file name}
    if ((pos('\',streng)=0) and (pos(':',streng)=0)) then assign(f,homedir+streng) else assign(f,streng); {Expand further}
    reset(f,1);
    if ioresult<>0 then slutlort(3);                        {If file does not exist, terminate and write cause of death}
    if (paramstr(paramcount)='+') then                    {Should we go resident?}
      begin {OK, we let TESS do the hard work}
        if (tsdoinit(tsrhot_g,tsrpopalt+tsrpopctrl,tsrusepopup,sizeofcode)<>0) then writeln('Cannot install');
      end
    else if (paramstr(paramcount)='-') then
    {Non-resident mode wanted}
      begin
        savedcsr:=csr;
        initscreen;
        read_header(0);
        read_menus(0);
        read_entry(mennu[0,1].filptr);
        createsmall;
        insertcursor;
        makemenu(3);
        keyhandler;
        screen:=savedscreen;
        close(f);
        if restorecrsr(savedcsr) then i:=i;
      end
    else slutlort(0);
    {If there is no (+/-) switch to determine mode , it is an error}
    end.